home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_emacs.idb / usr / freeware / share / emacs / 19.34 / lisp / mldrag.el.z / mldrag.el
Encoding:
Text File  |  1998-10-28  |  8.4 KB  |  229 lines
  1. ;;; mldrag.el --- mode line and vertical line dragging to resize windows
  2.  
  3. ;; Copyright (C) 1994 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Kyle E. Jones <kyle@wonderworks.com>
  6. ;; Keywords: mouse
  7.  
  8. ;; This file is part of GNU Emacs.
  9.  
  10. ;; GNU Emacs is free software; you can redistribute it and/or modify
  11. ;; it under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 2, or (at your option)
  13. ;; any later version.
  14.  
  15. ;; GNU Emacs is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. ;; GNU General Public License for more details.
  19.  
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23. ;; Boston, MA 02111-1307, USA.
  24.  
  25. ;;; Commentary:
  26.  
  27. ;; This package lets you drag the modeline, vertical bar and
  28. ;; scrollbar to resize windows.  Suggested bindings are:
  29. ;;
  30. ;;   (global-set-key [mode-line down-mouse-1] 'mldrag-drag-mode-line)
  31. ;;   (global-set-key [vertical-line down-mouse-1] 'mldrag-drag-vertical-line)
  32. ;;   (global-set-key [vertical-scroll-bar S-down-mouse-1]
  33. ;;                   'mldrag-drag-vertical-line)
  34. ;;
  35. ;; Put the bindings and (require 'mldrag) in your .emacs file.
  36.  
  37. ;;; Code:
  38.  
  39. (provide 'mldrag)
  40.  
  41. (defun mldrag-drag-mode-line (start-event)
  42.   "Change the height of the current window with the mouse.
  43. This command should be bound to a down-mouse- event, and is most
  44. usefully bound with the `mode-line' prefix.  Holding down a mouse
  45. button and moving the mouse up and down will make the clicked-on
  46. window taller or shorter."
  47.   (interactive "e")
  48.   (let ((done nil)
  49.     (echo-keystrokes 0)
  50.     (start-event-frame (window-frame (car (car (cdr start-event)))))
  51.     (start-event-window (car (car (cdr start-event))))
  52.     (start-nwindows (count-windows t))
  53.     (old-selected-window (selected-window))
  54.     should-enlarge-minibuffer
  55.     event mouse minibuffer y top bot edges wconfig params growth)
  56.     (setq params (frame-parameters))
  57.     (if (and (not (setq minibuffer (cdr (assq 'minibuffer params))))
  58.          (one-window-p t))
  59.     (error "Attempt to resize sole window"))
  60.     (unwind-protect
  61.     (track-mouse
  62.       (progn
  63.         ;; enlarge-window only works on the selected window, so
  64.         ;; we must select the window where the start event originated.
  65.         ;; unwind-protect will restore the old selected window later.
  66.         (select-window start-event-window)
  67.         ;; if this is the bottommost ordinary window, then to
  68.         ;; move its modeline the minibuffer must be enlarged.
  69.         (setq should-enlarge-minibuffer
  70.           (and minibuffer
  71.                (not (one-window-p t))
  72.                (= (nth 1 (window-edges minibuffer))
  73.               (nth 3 (window-edges)))))
  74.         ;; loop reading events and sampling the position of
  75.         ;; the mouse.
  76.         (while (not done)
  77.           (setq event (read-event)
  78.             mouse (mouse-position))
  79.           ;; do nothing if
  80.           ;;   - there is a switch-frame event.
  81.           ;;   - the mouse isn't in the frame that we started in
  82.           ;;   - the mouse isn't in any Emacs frame
  83.           ;; drag if
  84.           ;;   - there is a mouse-movement event
  85.           ;;   - there is a scroll-bar-movement event
  86.           ;;     (same as mouse movement for our purposes)
  87.           ;; quit if
  88.           ;;   - there is a keyboard event or some other unknown event
  89.           ;;     unknown event.
  90.           (cond ((integerp event)
  91.              (setq done t))
  92.             ((eq (car event) 'switch-frame)
  93.              nil)
  94.             ((not (memq (car event)
  95.                 '(mouse-movement scroll-bar-movement)))
  96.              (setq done t))
  97.             ((not (eq (car mouse) start-event-frame))
  98.              nil)
  99.             ((null (car (cdr mouse)))
  100.              nil)
  101.             (t
  102.              (setq y (cdr (cdr mouse))
  103.                edges (window-edges)
  104.                top (nth 1 edges)
  105.                bot (nth 3 edges))
  106.              ;; scale back a move that would make the
  107.              ;; window too short.
  108.              (cond ((< (- y top -1) window-min-height)
  109.                 (setq y (+ top window-min-height -1))))
  110.              ;; compute size change needed
  111.              (setq growth (- y bot -1)
  112.                wconfig (current-window-configuration))
  113.              ;; grow/shrink minibuffer?
  114.              (if should-enlarge-minibuffer
  115.              (progn
  116.                ;; yes.  briefly select minibuffer so
  117.                ;; enlarge-window will affect the
  118.                ;; correct window.
  119.                (select-window minibuffer)
  120.                ;; scale back shrinkage if it would
  121.                ;; make the minibuffer less than 1
  122.                ;; line tall.
  123.                (if (and (> growth 0)
  124.                     (< (- (window-height minibuffer)
  125.                       growth)
  126.                        1))
  127.                    (setq growth (1- (window-height minibuffer))))
  128.                (enlarge-window (- growth))
  129.                (select-window start-event-window))
  130.                ;; no.  grow/shrink the selected window
  131.                (enlarge-window growth))
  132.              ;; if this window's growth caused another
  133.              ;; window to be deleted because it was too
  134.              ;; short, rescind the change.
  135.              ;;
  136.              ;; if size change caused space to be stolen
  137.              ;; from a window above this one, rescind the
  138.              ;; change, but only if we didn't grow/srhink
  139.              ;; the minibuffer.  minibuffer size changes
  140.              ;; can cause all windows to shrink... no way
  141.              ;; around it.
  142.              (if (or (/= start-nwindows (count-windows t))
  143.                  (and (not should-enlarge-minibuffer)
  144.                   (/= top (nth 1 (window-edges)))))
  145.              (set-window-configuration wconfig)))))))
  146.       ;; restore the old selected window
  147.       (select-window old-selected-window))))
  148.  
  149. (defun mldrag-drag-vertical-line (start-event)
  150.   "Change the width of the current window with the mouse.
  151. This command should be bound to a down-mouse- event, and is most
  152. usefully bound with the `vertical-line' or the `vertical-scroll-bar'
  153. prefix.  Holding down a mouse button and moving the mouse left and
  154. right will make the clicked-on window thinner or wider."
  155.   (interactive "e")
  156.   (let ((done nil)
  157.     (echo-keystrokes 0)
  158.     (start-event-frame (window-frame (car (car (cdr start-event)))))
  159.     (start-event-window (car (car (cdr start-event))))
  160.     (start-nwindows (count-windows t))
  161.     (old-selected-window (selected-window))
  162.     event mouse x left right edges wconfig growth)
  163.     (if (one-window-p t)
  164.     (error "Attempt to resize sole ordinary window"))
  165.     (if (= (nth 2 (window-edges start-event-window))
  166.        (frame-width start-event-frame))
  167.     (error "Attempt to drag rightmost scrollbar"))
  168.     (unwind-protect
  169.     (track-mouse
  170.       (progn
  171.         ;; enlarge-window only works on the selected window, so
  172.         ;; we must select the window where the start event originated.
  173.         ;; unwind-protect will restore the old selected window later.
  174.         (select-window start-event-window)
  175.         ;; loop reading events and sampling the position of
  176.         ;; the mouse.
  177.         (while (not done)
  178.           (setq event (read-event)
  179.             mouse (mouse-position))
  180.           ;; do nothing if
  181.           ;;   - there is a switch-frame event.
  182.           ;;   - the mouse isn't in the frame that we started in
  183.           ;;   - the mouse isn't in any Emacs frame
  184.           ;; drag if
  185.           ;;   - there is a mouse-movement event
  186.           ;;   - there is a scroll-bar-movement event
  187.           ;;     (same as mouse movement for our purposes)
  188.           ;; quit if
  189.           ;;   - there is a keyboard event or some other unknown event
  190.           ;;     unknown event.
  191.           (cond ((integerp event)
  192.              (setq done t))
  193.             ((eq (car event) 'switch-frame)
  194.              nil)
  195.             ((not (memq (car event)
  196.                 '(mouse-movement scroll-bar-movement)))
  197.              (setq done t))
  198.             ((not (eq (car mouse) start-event-frame))
  199.              nil)
  200.             ((null (car (cdr mouse)))
  201.              nil)
  202.             (t
  203.              (setq x (car (cdr mouse))
  204.                edges (window-edges)
  205.                left (nth 0 edges)
  206.                right (nth 2 edges))
  207.              ;; scale back a move that would make the
  208.              ;; window too thin.
  209.              (cond ((< (- x left -1) window-min-width)
  210.                 (setq x (+ left window-min-width -1))))
  211.              ;; compute size change needed
  212.              (setq growth (- x right -1)
  213.                wconfig (current-window-configuration))
  214.              (enlarge-window growth t)
  215.              ;; if this window's growth caused another
  216.              ;; window to be deleted because it was too
  217.              ;; thin, rescind the change.
  218.              ;;
  219.              ;; if size change caused space to be stolen
  220.              ;; from a window to the left of this one,
  221.              ;; rescind the change.
  222.              (if (or (/= start-nwindows (count-windows t))
  223.                  (/= left (nth 0 (window-edges))))
  224.              (set-window-configuration wconfig)))))))
  225.       ;; restore the old selected window
  226.       (select-window old-selected-window))))
  227.  
  228. ;; mldrag.el ends here
  229.